MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 07 - 1991/07.07 Jul 91/Multi DA Source/Multi DA.p

Text File | 1990-04-12 | 20.5 KB | 785 lines | [TEXT/PJMM]

unit MenuDA;

interface

function Main (DCtlE: DCtlPtr;
                            IOPB: ParmBlkPtr;
                            driveCall: Integer): OSErr;

implementation

const
{Define all of the possible driver calls}
    DriverOpen = 0;
    DriverPrime = 1;
    DriverControl = 2;
    DriverStatus = 3;
    DriverClose = 4;

    OpenErr = -23;
    CloseErr = -24;

{Offsets to resource IDs for main dialog and }
{alert}
    DlogID = 0;
    AboutID = 0;

{Subitem resource numbers of our menus}
    AppleMenu = 0;
    AboutItem = 1;

    FileMenu = 1;
    NewWindowItem = 1;
    CloseItem = 2;
    QuitItem = 4;

    EditMenu = 2;
    undoItem = 1;
    cutItem = 3;
    copyItem = 4;
    pasteItem = 5;
    clearItem = 6;

    WindowMenu = 3;
    CleanupItem = 1;
    BeepItem = 2;

{Dialog itemlist}
    NewWindowButton = 1;
    EraseButton = 2;
    EditText = 3;

type
    MenuBar = (DAMenus, AppMenus);

var
    done: boolean;
    SavedMenuList: handle;
    MenuIDs: array[0..WindowMenu] of integer;
    OurMenus: array[0..WindowMenu] of MenuHandle;
    OurMenuBar: boolean;

    DCE: DCtlPtr;
    OurName: str255;
    NumWindows: integer;
    WindowCounter: integer;

{ ********************************************** }
{ ************Global Utility Functions********** }
{ ********************************************** }
{The actual resource IDs of our resources depends }
{on our desk accessory’s run-time device control }
{reference number (this gets switched around by }
{Font/DA Mover and Suitcase.  The “owned resource” }
{sub-ID never changes, however.  Use our dCtlRefNum }
{to get the run-time ID of our resources}
function GetResID (SubID: integer): integer;
    begin
        GetResID := BOR($C000, SubID + (BSL((Abs(DCE^.dCtlRefNum) - 1), 5)));
    end;

{-----------------------DAMenuKey---------------}
{MenuKey does not work from within a desk }
{accessory because the system does not respond }
{correctly to the meta-keys used in DA menus. This }
{procedure is a substitute for MenuKey that }
{performs the function correctly. Given a }
{character, this function will determine if it is a }
{menu meta-character and returns the menu ID in the }
{high order word and the item in the low order word }
{just as MenuKey does.  Note that this code makes }
{use of information stored in our globals, and is }
{NOT directly transferable to other desk }
{accessories.}
function DAMenuKey (cmd: char): longint;
    var
        i, item: integer;
        key: char;
    begin
{Return a ‘0’ as default}
        DAMenuKey := 0;
{Capitalize lowercase letters}
        if (cmd >= 'a') & (cmd <= 'z') then
            cmd := Chr(Ord(cmd) - (Ord('a') - Ord('A')));

{Loop through each menu, looking for matches}
        for i := 0 to WindowMenu do

{If we find an enabled menu then examine each }
{enabled item in turn until we find a matching }
{command key.}
            if BTST(OurMenus[i]^^.enableFlags, 0) then
                for item := 1 to CountMItems(OurMenus[i]) do

                    if BTST(OurMenus[i]^^.enableFlags, item) then begin
                            GetItemCmd(OurMenus[i], item, key);
                            if key <> Cmd then
                                cycle
                            else
                                DAMenuKey := BOR(item, BSL(MenuIDs[i], 16));
                            HiliteMenu(MenuIDs[i]);
                            Exit(DAMenuKey);
                        end

    end; {of FUNCTION MyMenuKey}


{**********************************************}
{************ Menu Handling Routines **********}
{**********************************************}

{-------------------InitMenus--------------}
{Fetch and install our menus, remembering the }
{application’s menu bar for later switching. We }
{return the menu ID of any of our menus for }
{installation into the dCtlMenu field of the device }
{control entry. It doesn’t matter exactly which of }
{our menus we return.}
function InitMenus: integer;
    const
        CurApName = $910; {Low memory global}
{Hard code the name of the desk accessory layer in }
{multifinder.  Note that there is a non-breaking }
{space between DA and Handler.}
        DALayer = 'DA Handler';
    var
        i: integer;
        name: str255;
    begin
        for i := 0 to WindowMenu do begin
                MenuIDs[i] := GetResID(i);
                OurMenus[i] := GetMenu(MenuIDs[i]);
                OurMenus[i]^^.MenuID := MenuIDs[i];
            end;

        AddResMenu(OurMenus[AppleMenu], 'DRVR');
        InitMenus := MenuIDs[AppleMenu];

{If we’ve been loaded into DA Handler, then we dim }
{out our desk accessories. This is done because DA }
{Handler does not like desk accessories opening }
{other desk accessories!}
        if StringPtr(CurApName)^ = DALayer then
            for i := 1 to CountMItems(OurMenus[AppleMenu]) do begin
                    GetItem(OurMenus[AppleMenu], i, name);
                    if name[1] = char($00) then
                        DisableItem(OurMenus[AppleMenu], i);
                end;
    end;


{-----------------SaveMenuBar-------------------}
{This procedure is called in order to make a copy }
{of, and save, the current menu bar data structure. }
{It is conceivable that it may be called twice in a }
{row, so dispose of any previously saved menubars.}
procedure SaveMenuBar;
    begin
        if SavedMenuList <> nil then
            Disposhandle(SavedMenuList);
        SavedMenuList := GetMenuBar;
    end;

{------------------InsertDAMenus-----------------}
procedure InsertDAMenus;
    var
        i: integer;
    begin
        ClearMenuBar;
        for i := 0 to WindowMenu do
            InsertMenu(OurMenus[i], 0);
    end;

{------------------AdjustMenus-------------------}
{This procedure adjusts the menus periodically to }
{allow for changes It would typically be used }
{enabling and disabling menuitems, changing item }
{names, etc. as appropriate for the DA’s state.}
procedure AdjustMenus;
    begin
        if NumWindows > 1 then
            enableItem(OurMenus[Filemenu], CloseItem)
        else
            disableItem(OurMenus[FileMenu], CloseItem)
    end;


{--------------------SetMenu--------------------}
{This procedure installs our menubar when one of }
{our windows becomes active. Pass it “DAMenus” to }
{install our DA’s menubar. Pass it “AppMenus” to }
{restore the application’s menubar.}
procedure SetMenu (which: MenuBar);
    var
        mBarEnable: ^integer;

{-----}
{FUNCTION OursIsActivating is used to determine if }
{one of our windows is about to come to the top. If }
{this is going to happen, then there is no use }
{switching menus when one of our windows is }
{deactivated. It calls EventAvail, looking for an }
{activate event in one of our own windows.}
    function OursIsActivating: boolean;
        var
            Evt: eventRecord;
            kind: integer;
        begin
            OursIsActivating := false;
            if EventAvail(activMask, Evt) & (BitAnd(Evt.modifiers, activeFlag) <> 0) then begin
                    kind := WindowPeek(Evt.message)^.windowkind;
                    OursIsActivating := (kind = DCE^.dctlRefNum)
                end
        end;

{-----}
    begin {PROCEDURE SetMenu}
        mBarEnable := Pointer($A20);
  {Install DA's menubar if requested to and our }
{menu bar isn't there already.}
        if (which = DAMenus) then begin
                if not OurMenuBar then begin
                        SaveMenuBar;
                        InsertDAMenus;
                        MBarEnable^ := DCE^.dctlMenu;
                        OurMenuBar := true;
                        DrawMenuBar
                    end
            end
        else if not OursIsActivating then begin
                SetMenuBar(SavedMenuList);
                MBarEnable^ := 0;
                OurMenuBar := False;
                DrawMenuBar
            end
    end;

{**********************************************}
{ ********* Window Handling Routines ********* }
{********************************************* }

{----------------ModifyWindows---------------- }
{PROCEDURE ModifyWindows is passed a procedure }
{parameter. It loops through our windows performing }
{the passed procedure on each of our windows, }
{starting with the window passed in Start. By }
{calling itself recursively, it performs the action }
{on the bottom-most window first and the top-most }
{window last. A neat trick! }
procedure ModifyWindows (Start: univ WindowPeek;
                                procedure DoSomething (aW: Windowptr));
    begin
        if Start = nil then
            Exit(ModifyWindows);
        WindowCounter := 1;
        ModifyWindows(Start^.NextWindow, DoSomething);
        if Start^.windowKind = DCE^.dctlRefNum then begin
                DoSomething(WindowPtr(Start));
                WindowCounter := succ(WindowCounter)
            end;
    end;

{------------------------------}
{The following procedures are used in calls to the }
{ModifyWindows procedure to do the same task to }
{each of our windows in turn...}

{PROCEDURE CleanupProc stacks the windows in place }
{one by one, using the WindowCounter global to keep }
{track of which window we’re working on.}
procedure CleanupProc (theWind: windowptr);
    const
        spacing = 10;
        vStart = 40;
        hStart = 5;
    begin
        HideWindow(theWind);
        MoveWindow(theWind, WindowCounter * spacing + hStart, WindowCounter * spacing + vStart, true);
        ShowWindow(theWind)
    end;

{------------------------------}
procedure BringWindowForward (aW: Windowptr);
    begin
        BringToFront(aW)
    end;

{--------------------OpenAWindow-----------------}
{FUNCTION OpenAWindow opens up a new window, }
{stores our DA’s dCtlRefNum into its windowKind }
{field so that the system knows it’s a DA’s window, }
{and sets the title and initial location in an }
{appropriate manner. We use the run-time name of }
{our desk accessory to form the window title. We }
{also bump up our window counter to keep track of }
{how many windows are open. This would be a good }
{place to store the windowptr into an array or }
{linked list, in order to keep track of the windows }
{more carefully.}
function OpenAWindow: Windowptr;
    var
        aW: windowptr;
        WindowNo: str255;
        theID: integer;
    begin
        theID := GetResID(DlogID);
        aW := GetNewDialog(theID, nil, pointer(-1));
        if aW <> nil then begin
                windowpeek(aW)^.windowKind := DCE^.dCtlRefNum;
                NumToString(NumWindows, WindowNo);
                SetWTitle(aW, concat(OurName, ' ', WindowNo));
                WindowCounter := NumWindows;
                CleanUpProc(aW);
                NumWindows := NumWindows + 1;
            end;
        OpenAWindow := aW
    end;


{-----------------CloseAWindow------------------}
{PROCEDURE CloseAWindow closes down one of our }
{windows and decrements the NumWindows counter, in }
{a more sophisticated desk accessory, it would }
{handle disposing of the various data structures, }
{files, etc. associated with the window. Note that }
{if the window we're closing is the same as that }
{stored in the dCtlWindow field, we must update the }
{field to point to a current valid window. Local }
{procedure UpdateDCE handles this task.}
procedure CloseAWindow (aWindow: WindowPtr);

{-----}
{Procedure UpdateDCE sets the DCE^.dCtlWindow }
{field to point to our topmost open window.  The }
{dCtlWindow field should always point to a valid }
{window or the desk accessory will die horribly in }
{a matter of ticks.}
    procedure UpdateDCE;
        var
            aWindow: WindowPeek;
        begin
            DCE^.dCtlWindow := nil;
            aWindow := WindowPeek(FrontWindow);
            while aWindow <> nil do
                if aWindow^.WindowKind = DCE^.dCtlRefNum then begin
                        DCE^.dCtlWindow := pointer(aWindow);
                        Exit(UpdateDCE);
                    end
                else
                    aWindow := aWindow^.NextWindow;
        end; {PROCEDURE UpdateDCE}

{----}
    begin {PROCEDURE CloseAWindow}
        DisposDialog(aWindow);
        NumWindows := NumWindows - 1;

        if DCE^.dCtlWindow = aWindow then
            UpdateDCE;
        SetMenu(AppMenus);
    end;

{ ********************************************** }
{ ***************** Menu Handlers*************** }
{ ********************************************** }

{------------------DoApple-----------------------}
{PROCEDURE DoApple handles the apple menu}
procedure DoApple (itemNo: integer);
    var
        dummy: integer;
        name: str255;
    begin
        if itemNo = AboutItem then
            dummy := Alert(GetResId(AboutID), nil)
        else begin
                GetItem(OurMenus[applemenu], itemNo, name);
                dummy := OpenDeskAcc(name);
            end
    end;

{--------------------DoFile---------------------}
{PROCEDURE DoFile handles the file menu}
procedure DoFile (ItemNo: integer);
    var
        dummy: windowptr;
    begin
        case ItemNo of
            NewWindowItem:
                dummy := OpenAWindow;
            CloseItem:
                CloseAWindow(FrontWindow);
            QuitItem:
                done := true;
        end;
    end;

{------------------DoEdit-----------------------}
{PROCEDURE DoEdit handles the Edit Menu}
procedure DoEdit (ItemNo: integer);
    var
        OurDlog: DialogPtr;
        dummy: integer;
    begin
        OurDlog := FrontWindow;
        if OurDlog <> nil then begin
   {Move the public scrap to the TE scrap for the }
{dialog manager’s use.}
                dummy := TEFromScrap;
                case ItemNo of
                    undoItem:
                        sysbeep(5);
                    cutItem:
                        DlgCut(OurDlog);
                    copyItem:
                        DlgCopy(OurDlog);
                    pasteItem:
                        DlgPaste(OurDlog);
                    clearItem:
                        DlgDelete(OurDlog);
                    otherwise
                end;
   {Move the TE scrap to the public scrap.}
                dummy := ZeroScrap;
                dummy := TEToScrap
            end
        else
            sysbeep(5);
    end;

{-----------------DoWindowMenu------------------}
{PROCEDURE DoWindowMenu handles the Windows menu}
procedure DoWindowMenu (itemNo: integer);
    begin
        case itemNo of
            CleanupItem:
                modifyWindows(FrontWindow, CleanupProc);
            BeepItem:
                sysbeep(20);
        end;
    end;

{--------------------DoMenus-----------------}
{PROCEDURE DoMenus is the main dispatch for all }
{menu selections. Since the menu IDs are determined }
{onlyat run time, we cannot use a CASE constant }
{structure here. Instead, we use a series of IF }
{ELSE statements to determine which of our menus }
{was chosen.}
procedure DoMenus (MenuNo, ItemNo: integer);
    var
        Str1, Str2: str255;
        dummy: integer;
        OurDlog: dialogptr;
    begin
        if MenuNo = MenuIDs[AppleMenu] then
            DoApple(ItemNo)
        else if MenuNo = MenuIDs[FileMenu] then
            DoFile(ItemNo)
        else if MenuNo = MenuIDs[EditMenu] then
            DoEdit(ItemNo)
        else if MenuNo = MenuIDs[WindowMenu] then
            DoWindowMenu(ItemNo);
        Hilitemenu(0);
    end;


{***********************************************}
{*********** Event Handling Routines ***********}
{***********************************************}

{-------------------DoActivate------------------}
{PROCEDURE DoActivate handles activate/deactivate }
{events in our DA's windows. On an activate event }
{we install the DA's menu bar and update }
{DCE^.dCtlWindow field to point to the active }
{window. This assures that if our DA is later }
{selected from the application's apple menu, our }
{current active window will be brought to the }
{foreground.}
procedure DoActivate (var Evt: eventrecord);
    var
        active: boolean;
        theWindow: Windowptr;
        kind: integer;
    begin
        active := BitAnd(Evt.modifiers, activeFlag) <> 0;
        if active then begin
                theWindow := pointer(Evt.message);
                kind := windowPeek(theWindow)^.windowkind;
                if kind <> DCE^.dctlRefNum then
                    Exit(DoActivate);
                DCE^.dCtlWindow := theWindow;
                SetMenu(DAMenus);
            end
        else
            SetMenu(AppMenus);
    end;

{------------------MetaKey------------------}
{FUNCTION MetaKey checks whether the cloverleaf key }
{was pressed during keypress. If so, it gets the }
{menu and item from DAMenuKey and passes the menu }
{selection on to DoMenus. If the cloverleaf was not }
{depressed, then CmdKey returns FALSE so that the }
{caller knows to handle the keypress normally.}
function MetaKey (var Evt: eventrecord): boolean;
    var
        aChr: char;
        Tangled: longint;
    begin
        if BitAnd(cmdKey, Evt.modifiers) <> 0 then begin
                aChr := Char(BitAnd(Evt.message, charCodeMask));
                Tangled := DAMenuKey(aChr);
                DoMenus(HiWord(Tangled), LoWord(Tangled));
                MetaKey := true
            end
        else
            MetaKey := false;
    end;

{--------------------DoIdle----------------------}
{PROCEDURE DoIdle gets called for null events. It }
{does two things:}
{{ 1. It checks the cursor and changes it into an }
{I-beam when the cursor is over the window’s text }
{edit field. }
{ 2. It manufacturer’s a “dummy” null event and }
{calls DialogSelect so that the text edit cursor }
{gets flashed.}
{This is the place to do any other background }
{processing.}
procedure DoIdle;
    var
        theDlog: DialogPtr;
        itemHit: integer;
        event: EventRecord;
        dummy: boolean;
        aPt: point;
    begin
        theDlog := DCE^.dctlWindow;

{First make the mouse into an I-Beam if we’re }
{above the text field}
        GetMouse(aPt);
        with dialogPeek(theDlog)^ do begin
                if textH <> nil then
                    if PtInRect(aPt, textH^^.viewRect) then
                        SetCursor(GetCursor(IBeamCursor)^^)
                    else
                        initCursor
            end;

{Next call DialogSelect with a null event in order }
{to blink the cursor}
        event.what := NullEvent;
        dummy := dialogSelect(event, theDlog, Itemhit)
    end;

{-------------------HandleEvents-----------------}
{PROCEDURE HandleEvents is the main dispatcher for }
{all events appertaining to our DA.}
procedure HandleEvents (var Evt: EventRecord);
    var
        dummy: windowptr;
        itemHit: integer;
        WhichDialog: DialogPtr;
    begin
        AdjustMenus;

{We do some pre-processing before calling }
{DialogSelect}
        case Evt.what of
            ActivateEvt:
                DoActivate(Evt);
            KeyDown, AutoKey:
                if MetaKey(Evt) then
                    Exit(HandleEvents);
            otherwise
        end;

{Here we call DialogSelect to do most of the }
{housekeeping window tasks}
        if DialogSelect(Evt, whichDialog, Itemhit) then
            case itemHit of
                NewWindowButton:
                    dummy := OpenAWindow;
                EraseButton:
                    begin
                        SelIText(whichDialog, EditText, 0, 10000);
                        DlgDelete(WhichDialog);
                    end;
                otherwise
            end;
    end; {procedure HandleEvents}


{************************************************}
{**************** Main DA Routines **************}
{************************************************}

{ ================== CLOSE ======================}
function CLOSE: OSErr;
    var
        i: integer;
    begin
        Close := NoErr;

{If we don’t have any window, then we haven’t been }
{opened and Close is being called}
{inappropriately.}
        if DCE^.dCtlWindow = nil then
            Exit(Close);

{Clean up after ourselves}
        with DCE^ do begin
                ModifyWindows(FrontWindow, CloseAWindow);
                dctlWindow := nil;

                for i := 0 to WindowMenu do
                    ReleaseResource(handle(OurMenus[i]));
                Disposhandle(SavedMenuList);
                dCtlMenu := 0;

            end;
    end; {of function CLOSE}


{ ================ OPEN =====================}
function OPEN (DCTlE: DCtlPtr;
                                IOPB: ParmBlkPtr): OsErr;
    var
        aWind: WindowPeek;
    begin
        open := NoErr;
        OurName := IOPB^.ioNamePtr^;
        with DCE^ do begin

                if dctlWindow = nil then

{The window is nil, so initialize and allocate }
{everything!}
                    begin
                        if dCtlStorage = nil then begin
                                Sysbeep(20);
                                Open := OpenErr;
                            end
                        else begin
                                dctlWindow := OpenAWindow;
                                dCtlMenu := InitMenus;
                            end
                    end

                else begin
{If we get here, then we are already open.  We }
{must bring all our windows forward. First bring }
{forward all windows below our topmost DA window. }
{This has the effect of bringing forward ALL our }
{windows when the DA is selected without changing }
{their relative order. Next select our topmost }
{window to bring it to the front.  The topmost }
{window is already stored in the DCE^.dctlWindow }
{field.}

                        aWind := WindowPeek(dctlWindow)^.nextWindow;
                        ModifyWindows(aWind, BringWindowForward);

 {Now select our topmost window}
                        SelectWindow(dctlWindow);
                    end;
            end; {of WITH clause}
    end; {of OPEN}

{=================== CONTROL =================== }
function CONTROL (IOPB: ParmBlkPtr): OsErr;
    const
        accGoodBye = -1;
    type
        EventPtr = ^EventRecord;
    var
        APort: GrafPtr;

    begin {functon CONTROL}

        Control := NoErr;
        GetPort(aPort);
        SetPort(DCE^.dctlWindow);

{Dispatch for all the different control calls}
        case IOPB^.csCode of
            accEvent:
                HandleEvents(EventPtr(IOPB^.ioMisc)^);
            accCursor:
                DoIdle;
            accMenu:
                DoMenus(IOPB^.csParam[0], IOPB^.csParam[1]);
            accGoodbye:
                Control := Close;
            otherwise
        end; {of case statement}

        SetPort(APort);
    end; {function CONTROL}


{******************************************}
{************MAIN FUNCTION*****************}
{******************************************}
{FUNCTION Main is the entry point for the DA. }
{THINK Pascal will intercept the driver }
{(OPEN/CLOSE/CONTROL) call and funnel it through }
{this routine, along with a pointer to the device }
{control entry, the parameter block, and a selector }
{indicating which driver call was made. Pascal very }
{nicely sets up a global storage block}
function MAIN (DCtlE: DCtlPtr;
                                IOPB: ParmBlkPtr;
                                driveCall: Integer): OSErr;
    begin
{Need to call RememberA4 up front if our dialogs }
{have user items or if we get called at interrupt }
{time.  This code doesn’t use these features, but }
{call it just in case.}
        RememberA4;
        Done := false;
        DCE := DCtlE;

        case driveCall of

            DriverOpen:
                Main := Open(DCtlE, IOPB);

            DriverControl:
                with DCE^ do begin
{Turn off further control calls while servicing }
{this one in order to avoid re-entrancy issues}
                        dCtlFlags := BitAnd(dCtlFlags, $FBFF);
                        Main := Control(IOPB);
                        dCtlFlags := BitOr(dCtlFlags, $0400);
                    end;

            DriverClose:
                if NumWindows > 1 then
{We have more than one window open, so just close }
{topmost}
                    begin
                        CloseAWindow(FrontWindow);
                        Main := CloseErr
                    end
                else
                    Main := Close;

            DriverStatus, DriverPrime:
                Main := NoErr;

        end; {case statement}

{This happens when the user selects “quit” from }
{the menus or there is a fatal error.}
        if Done then begin
                Main := Close;
                CloseDeskAcc(DCE^.dctlRefnum);
            end
    end; {of MAIN function}

end. {of the whole unit}